home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / turbovis / tvtoys04.zip / PAL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-17  |  10KB  |  397 lines
  1. (***************************************************************************
  2.   Palette unit
  3.   Change the palette on EGA and VGA video cards
  4.   PJB December 13, 1993, Internet mail to d91-pbr@nada.kth.se
  5.   Copyright PJB 1993, All Rights Reserved.
  6.   Free source, use at your own risk.
  7.   If modified, please state so if you pass this around.
  8.  
  9.   Originally written February 91, touched up for the TVToys project.
  10.   Tested on a lot of machines back then.
  11.  
  12.   ■ DON'T meddle with the EGA palette settings on a VGA, you'll be
  13.     sorry. Use VGA or RGB commands.
  14.  
  15.   The rules:           (EVGA means EGA and VGA)
  16.     You can do Palette.Init on any system, it checks for EVGA
  17.     You cannot use any palette routine except Init on anything but EVGA
  18.     Don't use the EGA commands on a VGA, use RGB or VGA commands
  19.     Use EGA or RGB commands on an EGA
  20.  
  21.     In other words, SetRGB works on both EGA and VGA.
  22.  
  23.  
  24.   Technical info:
  25.   An EGA has 64 fixed palette entries to choose from.
  26.   A VGA has 256 palette entries, the fixed EGA palette entries acting
  27.   like indexes in the VGA's palette. A VGA palette entry consists of
  28.   three bytes, one each for the amount of red, green and blue.
  29.   Only the lower six bits in each byte are used.
  30.  
  31.   So, you can only have 16 different colors on the screen at any one
  32.   time in text mode, and by changing the palette each of those 16 can
  33.   be chosen from one of 64 on an EGA or one of 262144 on a VGA.
  34.  
  35.  
  36.   Changing the video mode resets the palette to a system default.
  37.  
  38.   If EmulateVGA is true, RGB calls on an EGA system will be recalculated
  39.   to the nearest EGA equivalent which in fact works so well that you can
  40.   get a small fading effect even on an EGA.
  41.  
  42.   You might want to consider what happens if there is a run-time error
  43.   while the palette is in an undesirable state. There is no ExitProc
  44.   here as it depends on how video modes are handled. (Setting a video
  45.   mode resets the palette)
  46.  
  47.   Interrupts are off while accessing the palette.
  48.  
  49.   Any fade delays are usually caused by SmartDrive.
  50.  
  51. ***************************************************************************)
  52. unit Pal;
  53. {$O+}
  54.  
  55. interface
  56.  
  57.   uses
  58.     Objects,
  59.     Video;
  60.  
  61.   type
  62.     PEGAPalette = ^EGAPalette;
  63.     EGAPalette  = array [0..15] of Byte;
  64.  
  65.     RGBRec =
  66.       record
  67.         R, G, B : Byte;
  68.       end;
  69.  
  70.     PRGBPalette = ^RGBPalette;
  71.     RGBPalette  = array [0..15] of RGBRec;
  72.  
  73.     PaletteObject =
  74.       object
  75.         EGA         : EGAPalette;
  76.         RGB         : RGBPalette;
  77.         EmulateVGA  : Boolean;
  78.  
  79.         procedure Init;
  80.         procedure Load(var S:TStream);
  81.         procedure Store(var S:TStream);
  82.  
  83.         procedure GetEGA(var   Pal:EGAPalette);
  84.         procedure SetEGA(const Pal:EGAPalette);
  85.  
  86.         procedure GetVGA(var   Pal:RGBPalette);
  87.         procedure SetVGA(const Pal:RGBPalette);
  88.  
  89.         procedure GetRGB(var   Pal:RGBPalette);
  90.         procedure SetRGB(const Pal:RGBPalette);
  91.  
  92.         procedure FadeTo(const Pal:RGBPalette; Delta:Integer);
  93.       end;
  94.  
  95.   var
  96.     VideoPalette : PaletteObject;
  97.  
  98.  
  99.   procedure WaitForRetrace;
  100.  
  101.  
  102. (***************************************************************************
  103. ***************************************************************************)
  104. implementation
  105.  
  106.  
  107.   (*******************************************************************
  108.     Wait for a vertical retrace, used to update the palette when it
  109.     won't disturb the display
  110.   *******************************************************************)
  111.   procedure WaitForRetrace; assembler;
  112.   asm
  113.       mov  es,Seg0040
  114.       mov  dx,es:[Addr6845]
  115.       add  dx,6
  116.  
  117.     @1:
  118.       in   al,dx
  119.       test al,8
  120.       jne  @1
  121.  
  122.     @2:
  123.       in   al,dx
  124.       test al,8
  125.       je   @2
  126.   end;
  127.  
  128.  
  129.     (*******************************************************************
  130.     *******************************************************************)
  131.  
  132.   (*******************************************************************
  133.     Init, store the original palette
  134.   *******************************************************************)
  135.   procedure PaletteObject.Init;
  136.   begin
  137.     if VideoType<>Other then
  138.     begin
  139.       EmulateVGA:=VideoType=Video.EGA;
  140.       GetEGA(EGA);
  141.       GetRGB(RGB);
  142.     end;
  143.   end;
  144.  
  145.  
  146.   (*******************************************************************
  147.     Read palette from a stream
  148.   *******************************************************************)
  149.   procedure PaletteObject.Load;
  150.     var
  151.       Temp : RGBPalette;
  152.   begin
  153.     S.Read(Temp, SizeOf(Temp));
  154.     if S.Status=stOK then
  155.       RGB:=Temp;
  156.   end;
  157.  
  158.  
  159.   (*******************************************************************
  160.     Write palette to a stream
  161.   *******************************************************************)
  162.   procedure PaletteObject.Store;
  163.   begin
  164.     S.Write(RGB, SizeOf(RGB));
  165.   end;
  166.  
  167.  
  168.   (*******************************************************************
  169.     Read the EGA's palette registers
  170.   *******************************************************************)
  171.   procedure PaletteObject.GetEGA;
  172.   begin
  173.     asm
  174.       mov      cx,16
  175.       mov      es,Seg0040
  176.       mov      dx,es:[Addr6845]
  177.       add      dx,6
  178.       mov      si,03C0h
  179.       les      di,Pal
  180.       mov      bl,0
  181.       cld
  182.       cli
  183.     @1:
  184.       in       al,dx
  185.       xchg     dx,si
  186.  
  187.       mov      al,bl
  188.       inc      bl
  189.       out      dx,al
  190.  
  191.       inc      dx
  192.       in       al,dx
  193.       dec      dx
  194.       stosb
  195.  
  196.       xchg     dx,si
  197.       in       al,dx
  198.       loop     @1
  199.       sti
  200.  
  201.       mov      al,20h
  202.       xchg     dx,si
  203.       out      dx,al
  204.     end;
  205.     EGA:=Pal;
  206.   end;
  207.  
  208.  
  209.   (*******************************************************************
  210.     Set the EGA's palette registers
  211.   *******************************************************************)
  212.   procedure PaletteObject.SetEGA;
  213.   begin
  214.     asm
  215.       call     WaitForRetrace
  216.       push     ds
  217.       mov      cx,16
  218.       mov      es,Seg0040
  219.       mov      dx,es:[Addr6845]
  220.       add      dx,6
  221.       mov      di,03C0h
  222.       lds      si,Pal
  223.       mov      bl,0
  224.       cld
  225.       cli
  226.     @1:
  227.       in       al,dx
  228.       xchg     dx,di
  229.  
  230.       mov      al,bl
  231.       inc      bl
  232.       out      dx,al
  233.       lodsb
  234.       out      dx,al
  235.  
  236.       xchg     dx,di
  237.       in       al,dx
  238.       loop     @1
  239.       sti
  240.  
  241.       mov      al,20h
  242.       xchg     dx,di
  243.       out      dx,al
  244.       pop      ds
  245.     end;
  246.     EGA:=Pal;
  247.   end;
  248.  
  249.  
  250.   (*******************************************************************
  251.     Read DAC palette settings on VGA
  252.   *******************************************************************)
  253.   procedure PaletteObject.GetVGA; assembler;
  254.   asm
  255.       push      ds
  256.       mov       cx,16
  257.       mov       dx,03C7h
  258.       lds       si,Self
  259.       les       di,Pal
  260.       add       si,EGA
  261.       cld
  262.       cli
  263.     @1:
  264.       lodsb
  265.       out       dx,al
  266.       add       dx,2
  267.       in        al,dx
  268.       stosb
  269.       in        al,dx
  270.       stosb
  271.       in        al,dx
  272.       stosb
  273.       sub       dx,2
  274.       loop      @1
  275.       sti
  276.       pop       ds
  277.   end;
  278.  
  279.  
  280.   (*******************************************************************
  281.     Set 16 DAC palette entries on VGA
  282.   *******************************************************************)
  283.   procedure PaletteObject.SetVGA; assembler;
  284.   asm
  285.       call    WaitForRetrace
  286.  
  287.       push    ds
  288.       mov     cx,16
  289.       mov     dx,03C8h
  290.       lds     si,Pal
  291.       les     di,Self
  292.       add     di,EGA
  293.       cld
  294.       cli
  295.     @1:
  296.       mov     al,es:[di]
  297.       inc     di
  298.       out     dx,al
  299.       inc     dx
  300.       lodsb
  301.       out     dx,al
  302.       lodsb
  303.       out     dx,al
  304.       lodsb
  305.       out     dx,al
  306.       dec     dx
  307.       loop    @1
  308.       sti
  309.       pop     ds
  310.   end;
  311.  
  312.  
  313.   (*******************************************************************
  314.     Get palette on EGA or VGA, convert RGB on EGA
  315.   *******************************************************************)
  316.   procedure PaletteObject.GetRGB;
  317.     function F(B:Byte):Byte;